home *** CD-ROM | disk | FTP | other *** search
/ Over 1,000 Windows 95 Programs / Over 1000 Windows 95 Programs (Microforum) (Disc 1).iso / 1262 / samples / invoice.pr_ / invoice.pr
Text File  |  1995-03-14  |  9KB  |  256 lines
  1. * Generated by EasyCODE(SPX) V5.1 at 15.03.1995 18:20:33
  2. * with C:\EASY\SAMPLES\SPX-XBS\DBASE.CFG
  3.  
  4. * Invoice
  5.  
  6. * Main procedure
  7.   PROCEDURE Invoice
  8.      * Connection to external procedure file
  9.      SET PROCEDURE TO Library
  10.      * Define working environment
  11.      DO Set_env
  12.      SET COLOR TO &c_standard.
  13.      * Create variables
  14.      STORE "" TO cust_nr, comment, note, inv_nr, inv_old
  15.      STORE 0 TO amnt_ord, ord_payed, amount, last_amnt, payed, balance_old
  16.      STORE {  .  .  } TO inv_date, last_inv
  17.      * Variables needed for parameter passing to library
  18.      dbf      = "INVOICE"                  && Standard report available
  19.      mlist    = "NOT AVAILABLE"            && Labels not available
  20.      cust_rpt = "NOT AVAILABLE"            && Customer report not available
  21.      STORE "m->inv_nr" TO key, key1
  22.      STORE "NONE" TO key2, key3
  23.      keyname1 = "Invoice Number:"
  24.      STORE "" TO keyname2, keyname3
  25.      list_flds = "INV_NR, CUST_NR, INV_DATE, AMOUNT, BALANCE_OLD"
  26.      STORE 0 TO balance, age
  27.      * Activate database and index files
  28.      SELECT 1
  29.      USE Invoice ORDER Invoice
  30.      USE Customers  ORDER Customers IN 2
  31.      SET RELATION TO cust_nr INTO Customers
  32.      GO TOP
  33.      record_num = RECNO()
  34.      * Load first record into variables
  35.      DO Load_fld
  36.      * Display on screen
  37.      CLEAR
  38.      DO Dstatus
  39.      DO Backgrnd
  40.      DO Show_data
  41.      * Definition of popup menu
  42.      DO Bar_def
  43.      * Activate main popup menu (acc. to user sel.)
  44.      SET COLOR TO &c_popup.
  45.      ACTIVATE POPUP main_mnu
  46.      DO Sub_ret
  47.   RETURN
  48. * Indexer
  49.   PROCEDURE Indexer
  50.      * Create new index
  51.      INDEX ON balance_old TAG Bilanz
  52.      INDEX ON cust_nr     TAG Kunde
  53.      INDEX ON inv_nr      TAG Invoice
  54.      GO TOP
  55.   RETURN
  56. * Init_fld
  57.   PROCEDURE Init_fld
  58.      * Initialize variables for data input
  59.      STORE SPACE(10) TO inv_nr, inv_old
  60.      cust_nr = SPACE(6)
  61.      STORE 0 TO amnt_ord, amount, last_amnt, payed
  62.      STORE SPACE(30) TO comment, note
  63.      STORE {  .  .  } TO inv_date, last_inv
  64.   RETURN
  65. * Load_fld
  66.   PROCEDURE Load_fld
  67.      * Load data from database INVOICE into variables
  68.      inv_nr      = inv_nr
  69.      cust_nr     = cust_nr
  70.      amnt_ord    = amnt_ord
  71.      ord_payed   = ord_payed
  72.      inv_date    = inv_date
  73.      amount      = amount
  74.      comment     = comment
  75.      note        = note
  76.      last_inv    = last_inv
  77.      last_amnt   = last_amnt
  78.      payed       = payed
  79.      balance_old = balance_old
  80.      inv_old  = inv_old
  81.   RETURN
  82. * Repl_fld
  83.   PROCEDURE Repl_fld
  84.      * Replace contents of fields with actual values of variables
  85.      REPLACE inv_nr WITH m->inv_nr, cust_nr WITH m->cust_nr,;
  86.              amnt_ord WITH m->amnt_ord, inv_date WITH m->inv_date,;
  87.              amount WITH m->amount, comment WITH m->comment
  88.      REPLACE note WITH m->note, last_inv WITH m->last_inv,;
  89.              last_amnt WITH m->last_amnt, payed WITH m->payed,;
  90.              inv_old WITH m->inv_old, balance_old WITH m->balance_old,;
  91.              ord_payed WITH m->ord_payed
  92.   RETURN
  93. * Backgrnd
  94.   PROCEDURE Backgrnd
  95.      * Screen for data input and output
  96.      * Draw frame
  97.      @  1,18 TO  3,41 DOUBLE COLOR &c_blue.
  98.      @  5, 1 TO  7,56 DOUBLE COLOR &c_red.
  99.      @  2,19 FILL TO  2,40   COLOR &c_red.
  100.      @  6, 2 FILL TO  6,55   COLOR &c_red.
  101.      @  9, 2 FILL TO 20,55   COLOR &c_red.
  102.      @ 10, 1 TO 10,56        COLOR &c_red.
  103.      @ 18, 1 TO 18,56        COLOR &c_red.
  104.      @  8, 1 TO 21,56        COLOR &c_red.
  105.      SET COLOR TO &c_data.
  106.      @  2,20 SAY "   ACCOUNTS"
  107.      @  6, 3 SAY "INVOICE NUMBER:"
  108.      @  6,30 SAY "INVOICE DATE:"
  109.      @  9, 3 SAY "CUSTOMER NUMBER:"
  110.      @ 11, 3 SAY "- LAST INVOICE -"
  111.      @ 12, 3 SAY "NUMBER:"
  112.      @ 13, 3 SAY "DATE: "
  113.      @ 11,28 SAY "--------- AMOUNTS ----------"
  114.      @ 12,28 SAY "LAST INVOICE ($)"
  115.      @ 14, 3 SAY "Days over"
  116.      @ 13,28 SAY "LAST PAYMENT ($)"
  117.      @ 14,28 SAY "OLD BALANCE  ($)"
  118.      @ 15,28 SAY "ACTUAL ORDER ($)"
  119.      @ 17, 3 SAY "PAYED        ($)"
  120.      @ 17,28 SAY "RECEIVABLES  ($)"
  121.      @ 19, 3 SAY "COMMENT:"
  122.      @ 20, 3 SAY "NOTE:   "
  123.      SET COLOR TO &c_standard.
  124.   RETURN
  125. * Show_data
  126.   PROCEDURE Show_data
  127.      * Screen for data input and output
  128.      * Compute temporary data
  129.      * Balance_old = Last_Invoice - Last_Payment
  130.      balance_old = m->last_amnt - m->payed
  131.      * Amount of this invoice is Old_Balance + New_Invoice_Amount
  132.      amount = m->balance_old + m->amnt_ord
  133.      * Is there an outstanding invoice
  134.      age = IIF(m->balance_old > 0,DATE() - m->last_inv,0)
  135.      *
  136.      SET COLOR TO &c_data.
  137.      @  6,19 SAY m->inv_nr
  138.      @  6,47 SAY m->inv_date
  139.      @  9,16 SAY m->cust_nr
  140.      @  9,26 SAY Customers->Customer  FUNCTION "!" COLOR &c_yelowhit.
  141.      @ 12,11 SAY m->inv_old
  142.      @ 13,11 SAY m->last_inv
  143.      * Display in color if outstanding invoice
  144.      IF ISCOLOR()
  145.         * Color screen
  146.         DO CASE
  147.            CASE m->age >= 60
  148.               age_color = c_red          && Red for danger
  149.            CASE       (m->age < 60);
  150.                 .AND. (age >= 45)
  151.               age_color = c_yellow       && Yellow for attention
  152.            CASE m->age < 45
  153.               age_color = c_green        && Green - OK
  154.         ENDCASE
  155.      ELSE
  156.         * Monochrome screen
  157.         age_color = "W"
  158.      ENDIF
  159.      @ 12,46 SAY m->last_amnt PICTURE "999,999.99"
  160.      @ 14,20 SAY m->age PICTURE "999" COLOR &age_color.
  161.      @ 13,46 SAY m->payed PICTURE "999,999.99"
  162.      IF ISCOLOR()
  163.          * Color screen
  164.         DO CASE
  165.            CASE balance_old >= 1000
  166.               bal_color = c_red
  167.            CASE       (balance_old <= 1000);
  168.                 .AND. (balance_old >= 100)
  169.               bal_color = c_yelowhit
  170.            CASE balance_old < 100
  171.               bal_color = c_green
  172.         ENDCASE
  173.      ELSE
  174.         * Monochrome screen
  175.         bal_color = "W"
  176.      ENDIF
  177.      @ 14,46 SAY m->balance_old      PICTURE "999,999.99" COLOR &bal_color.
  178.      @ 15,46 SAY m->amnt_ord  PICTURE "999,999.99"
  179.      @ 17,16 SAY m->ord_payed   PICTURE "999,999.99"
  180.      @ 17,46 SAY m->amount     PICTURE "999,999.99" COLOR &c_yelowhit.
  181.      @ 19,16 SAY m->comment
  182.      @ 20,10 SAY m->note
  183.      IF ISCOLOR()
  184.         @ 22,1 SAY "Parts not yellow are computed" ;
  185.            COLOR &c_yelowhit.
  186.      ELSE
  187.         @ 22,1 SAY "Parts not colored are computed"
  188.      ENDIF
  189.      SET COLOR TO &c_standard.
  190.   RETURN
  191. * Get_data
  192.   PROCEDURE Get_data
  193.      * Note: RECEIVABLES ($), COMMENT and NOTICE are the onl input fields.
  194.      *        All other data is updated automatically when printed.
  195.      * Compute temporary data
  196.      * Balance_old = Last_Invoice - Last_Payment
  197.      balance_old = m->last_amnt - m->payed
  198.      * Amount of this invoice is Old_Balance + New_Invoice_Amount
  199.      amount = m->balance_old + m->amnt_ord
  200.      * Are there outstanding invoices
  201.      age = IIF(m->balance_old > 0,DATE() - m->last_inv,0)
  202.      *
  203.      SET COLOR TO &c_data.
  204.      @  6,19   GET m->inv_nr ;
  205.         VALID Duplicat(m->inv_nr) ERROR "Invoice number already exists - Re-enter" ;
  206.         MESSAGE "Enter valid invoice number (Customer Number + year * month)"
  207.      @  6,47   GET m->inv_date
  208.      @  9,16   GET m->cust_nr   PICTURE "!!9999";
  209.         VALID Lookupid(m->cust_nr)   ERROR "Customer Number already exists - Re-enter"
  210.      @ 12,11   GET m->inv_old
  211.      @ 13,11   GET m->last_inv FUNCTION "D"
  212.      * Color display if there are outstanding invoices
  213.      IF ISCOLOR()
  214.         DO CASE
  215.            CASE m->age >= 60
  216.               age_color = c_red          && Red for danger
  217.            CASE       (m->age < 60);
  218.                 .AND. (age >= 45)
  219.               age_color = c_yellow       && Gelb for attention
  220.            CASE m->age < 45
  221.               age_color = c_green        && Green - OK
  222.         ENDCASE
  223.      ELSE
  224.         * Monochrome screen
  225.         age_color = "W"
  226.      ENDIF
  227.      @ 12,46 GET m->last_amnt PICTURE "999,999.99"
  228.      @ 13,46 GET m->payed PICTURE "999,999.99"
  229.      IF ISCOLOR()
  230.         DO CASE
  231.            CASE balance_old >= 1000
  232.               bal_color = c_red
  233.            CASE       (balance_old <= 1000);
  234.                 .AND. (balance_old >= 100)
  235.               bal_color = c_yelowhit
  236.            CASE balance_old < 100
  237.               bal_color = c_green
  238.         ENDCASE
  239.      ELSE
  240.         * Monochrome screen
  241.         bal_color = "W"
  242.      ENDIF
  243.      @ 15,46 GET m->amnt_ord PICTURE "999,999.99"
  244.      @ 17,16 GET m->ord_payed PICTURE "999,999.99"
  245.      @ 19,16 GET m->comment  FUNCTION "!"
  246.      @ 20,10 GET m->note     FUNCTION "!"
  247.      IF ISCOLOR()
  248.         @ 22,1 SAY "Parts not yellow are computed" ;
  249.           COLOR &c_yelowhit.
  250.      ELSE
  251.         @ 22,1 SAY "Parts not colored are computed"
  252.      ENDIF
  253.      SET COLOR TO &c_standard.
  254.      ON KEY LABEL F9 DO Findcust with m->cust_nr
  255.   RETURN
  256.